perm filename TEST2.SAI[GEO,BGB]1 blob sn#013174 filedate 1972-11-18 generic text, type T, neo UTF8
00100	BEGIN "TEST"
00200		REQUIRE "ABBREV" SOURCE_FILE;
00300		REQUIRE "DPYIII" SOURCE_FILE;
00400		REQUIRE "DPYIII" LOAD_MODULE;
00500		SAFE INTEGER ARRAY RAN5[0:255];
00600		INTEGER RAN1,RAN2,RAN3,RAN4,INITFLG;
00700	PROCEDURE RANDOMI;
00800	BEGIN	"INIT"
00900		INTEGER I;
01000		RAN1←1;
01100		RAN2←3; 
01200		FOR I←0 STEP 1 UNTIL 255 DO
01300		RAN5[I]←RAN2←(RAN2*3)MOD 2↑31 ;
01400		INITFLG	←	TRUE;
01500	END	"INIT";
01600	
01700	INTERNAL REAL PROCEDURE RANDOM;
01800	BEGIN	"RANDOM"
01900		IF INITFLG THEN ELSE RANDOMI;
02000		RAN1←(RAN2*1756) MOD 8191;
02100		RAN3←RAN1 DIV 32;
02200		RAN4←RAN5[RAN3];
02300		RAN2←RAN5[RAN3]←(RAN2*3)MOD 2↑31;
02400		RETURN(RAN4/2↑31)
02500	END	"RANDOM";
     

00100	α DECLARATIONS;
00200		REAL A,B,C,Q;
00300		REAL X,Y; INTEGER IX,IY,I,J;
00400		SAFE ITG ARRAY DPYBUF[0:400];
00500		SAFE ITG ARRAY ZZZ[0:200];
00600		SAFE REAL ARRAY XXX[0:200];
00700		SAFE REAL ARRAY YYY[0:200];
00800		REAL SX,XX,XY,SY,YY;
00850		REAL W;
00900	
00925		FOR I←1 TO 30 DO OUTSTR(↓);
00937		WHILE TRUE DO
00950		FOR W ← 0.0 STEP 0.02 UNTIL 1.1 DO
00975	BEGIN "BIG"
01000	α DISPLAY INITIALIZATION;
01100		DPYSET(DPYBUF);	AIVECT(-500,-500);
01200		AVECT(+500,-500);	AVECT(+500,+500);
01300		AVECT(-500,+500);	AVECT(-500,-500);
01400	
01500		AIVECT(-500,0);AVECT(+500,0);
01600		AIVECT(0,-500);AVECT(0,+500);
01700	
01800		AIVECT(-400,-400);
01900		AVECT(+400,-400);	AVECT(+400,+400);
02000		AVECT(-400,+400);	AVECT(-400,-400);
02100	
02200		SX←SY←XX←YY←XY←0; J←0;
     

00100		J ← 0;
00200		FOR X ← -1 STEP 0.02 UNTIL +1.01 DO
00300	BEGIN
00400		Y ← 0.3*X + 0.1;
00500		IF X=-1 THEN AIVECT(X*400,Y*350) ELSE AVECT(X*400,Y*350);
00600		XXX[J] ← X + W*(RANDOM-0.5);
00700		YYY[J] ← Y + W*(RANDOM-0.5);
00800	
00900		SX ← SX + XXX[J];
01000		SY ← SY + YYY[J];
01100		XY ← XY + XXX[J]*YYY[J];
01200		XX ← XX + XXX[J]*XXX[J];
01300		YY ← YY + YYY[J]*YYY[J];
01400		J←J+1;
01500	END;
     

00100		FOR I←0 TO J-1 DO
00200		⊂ AIVECT(XXX[I]*400-12,YYY[I]*350-9);DPYSST("o");⊃;
00300	
00400		A ←  J*XY-SX*SY;
00500		B ← SX*SX-J*XX;
00600		C ← SY*XX-XY*SX;
00700	
00800		C ← -C/B;  A ← -A/B;
00900		AIVECT(-400,350*(C-A));
01000		 AVECT(+400,350*(C+A));
01100	
01200		A ← SY*SY-J*YY;
01300		B ← J*XY - SY*SX;
01400		C ← SX*YY - XY*SY;
01500		
01600		C ← -C/B; A ← -A/B;
01700		AIVECT(-400,350*(C-A));
01800		 AVECT(+400,350*(C+A));
01900	
02000		Q ← J*XY - SY*SX;
02100		A ← Q + SY*SY - J*YY;
02200		B ← Q + SX*SX - J*XX;
02300		C ← SX*YY + SY*XX - XY*(SX+SY);
02400	
02500		C ← -C/B;  A ← -A/B;
02600		AIVECT(-400,350*(C-A));
02700		 AVECT(+400,350*(C+A));
     

00100		DPYOUT(0);
00300	α	INCHRW;
00350	END "BIG";
00400	END;